home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / additionals / TkGS < prev    next >
Encoding:
Text File  |  1993-11-20  |  7.9 KB  |  253 lines

  1. # Program: xf
  2. # Description: handle text widgets
  3. #
  4. # $Header: TkGS[2.3] Wed Mar 10 11:57:33 1993 garfield@garfield frozen $
  5.  
  6. global xfDefaultConf
  7. set xfDefaultConf(tkgs) 4
  8.  
  9. ##########
  10. # Procedure: XFAdd.TkGS
  11. # Description: add a tkGS
  12. # Arguments: xfW - the widget
  13. #            xfName - a optional name
  14. #            xfType - add or config
  15. # Returns: none
  16. # Sideeffects: none
  17. ##########
  18. proc XFAdd.TkGS {xfW xfName xfType} {
  19.   global xfFile
  20.   global xfStatus
  21.  
  22.   XFEditSetStatus "Inserting TkGS..."
  23.   set xfName [XFMiscGetUniqueName $xfName gs]
  24.   set xfTmpOptions ""
  25.   if {"$xfFile(gsCmd)" != ""} {
  26.     append xfTmpOptions " -command \{$xfFile(gsCmd)\}"
  27.   }
  28.   if {"$xfStatus(path)" == "."} {
  29.     if {[catch "tkgs .$xfName $xfTmpOptions" xfResult]} {
  30.       XFProcError "$xfResult"
  31.       XFEditSetStatus "Inserting TkGS...aborted"
  32.       return
  33.     }
  34.  
  35.     XFMiscPositionWidget .$xfName
  36.     XFMiscBindWidgetTree .$xfName
  37.   } {
  38.     if {[catch "tkgs $xfStatus(path).$xfName $xfTmpOptions" xfResult] != 0} {
  39.       XFProcError "$xfResult"
  40.       XFEditSetStatus "Inserting TkGS...aborted"
  41.       return
  42.     }
  43.  
  44.     XFMiscPositionWidget $xfStatus(path).$xfName
  45.     XFMiscBindWidgetTree $xfStatus(path).$xfName
  46.   }
  47.  
  48.   incr xfStatus(elementCounter)
  49.   XFEditSetPath $xfStatus(path)
  50.   XFEditSetStatus "Inserting TkGS...done"
  51. }
  52.  
  53. ##########
  54. # Procedure: XFAddTmp.TkGS
  55. # Description: add a tmp tkGS
  56. # Arguments: none
  57. # Returns: none
  58. # Sideeffects: none
  59. ##########
  60. proc XFAddTmp.TkGS {} {
  61. }
  62.  
  63. ##########
  64. # Procedure: XFConfig.TkGS4
  65. # Description: configure a tkGS
  66. # Arguments: xfW - the widget
  67. #            xfType - config type (add config)
  68. #            xfClass - the class we configure
  69. #            xfLeader - the leading window
  70. # Returns: none
  71. # Sideeffects: none
  72. ##########
  73. proc XFConfig.TkGS4 {xfW xfType xfClass {xfLeader ""}} {
  74.   global xfBind
  75.   global xfMisc
  76.   global xfStatus
  77.  
  78.   if {"$xfType" == "add"} {
  79.     set xfName gs$xfStatus(elementCounter)
  80.   } {
  81.     set xfName [XFMiscPathName $xfW]
  82.   }
  83.   XFEditSetStatus "Calling parameter setting for TkGS..."
  84.  
  85.   # build widget structure
  86.   XFTmpltToplevel .xf${xfClass}Config4 400x540 \
  87.     "TkGS parameters:[XFMiscPathTail $xfW]" $xfLeader
  88.  
  89.   XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass \
  90.     XFTkGSSetTkGS4 parameters $xfName 4
  91.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
  92.     background Background "Background" XFTkGSSetTkGS4
  93.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass borderwidth \
  94.     borderWidth BorderWidth "Border width" "pixels" 40 XFTkGSSetTkGS4
  95.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  96.     bbox bbox Bbox "Bounding box" XFTkGSSetTkGS4
  97.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  98.     command command Command "GS command" XFTkGSSetTkGS4
  99.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  100.     file file File "File" XFTkGSSetTkGS4
  101.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass orient \
  102.     orient Orientation "Orientation" "degree" 360 XFTkGSSetTkGS4
  103.   XFElementRelief $xfW .xf${xfClass}Config4 $xfType $xfClass \
  104.     XFTkGSSetTkGS4
  105.   XFElementSize $xfW .xf${xfClass}Config4 $xfType $xfClass \
  106.     XFTkGSSetTkGS4
  107.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass xdpi \
  108.     xDpi XDpi "X Dpi" "pixels" 600 XFTkGSSetTkGS4
  109.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass ydpi \
  110.     yDpi YDpi "Y Dpi" "pixels" 600 XFTkGSSetTkGS4
  111.   .xf${xfClass}Config4.params1.params2.size.size1.size1 conf -to 1000
  112.   .xf${xfClass}Config4.params1.params2.size.size2.size2 conf -to 1000
  113.  
  114.   # save current parameter
  115.   XFElementSave $xfW $xfClass {background bbox borderwidth command file height orient relief width xdpi ydpi}
  116.  
  117.   # binding
  118.   bind .xf${xfClass}Config4.params1.params2.file.file $xfBind(configure) \
  119.     "XFProcFSBoxFile {.xf${xfClass}Config4.params1.params2.file.file}"
  120.  
  121.   # packing
  122.   pack append .xf${xfClass}Config4.params1 \
  123.               .xf${xfClass}Config4.params1.params2 {left fill expand}
  124.   pack append .xf${xfClass}Config4 \
  125.               .xf${xfClass}Config4.pathname {top fill frame center} \
  126.               .xf${xfClass}Config4.leave {bottom fill} \
  127.               .xf${xfClass}Config4.additional {bottom fill} \
  128.               .xf${xfClass}Config4.params1 {top fill expand}
  129.  
  130.   XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
  131.     "XFTkGSSetTkGS4 $xfW 0 $xfClass"
  132.  
  133.   XFEditSetStatus "Calling parameter setting for TkGS...done"
  134. }
  135.  
  136. ##########
  137. # Procedure: XFSaveSpecial.TkGS
  138. # Description: save tkGS
  139. # Arguments: xfW - the widget
  140. # Returns: none
  141. # Sideeffects: none
  142. ##########
  143. proc XFSaveSpecial.TkGS {xfW} {
  144.  
  145. #  puts $xfOutFile ""
  146. #  puts $xfOutFile "  $xfW insert end \{[XFMiscGetText $xfW]\}"
  147. }
  148.  
  149. ##########
  150. # Procedure: XFSaveWidget.TkGS
  151. # Description: save tkGS widget
  152. # Arguments: xfOutFile - the output file
  153. #            xfW - the widget
  154. # Returns: none
  155. # Sideeffects: none
  156. ##########
  157. proc XFSaveWidget.TkGS {xfOutFile xfW} {
  158.   global xfConf
  159.   global xfFile
  160.  
  161.   set xfType [string tolower [winfo class $xfW]]
  162.  
  163.   # what are we doing here ?
  164.   puts $xfOutFile "\n  # build widget $xfW"
  165.  
  166.   set xfTmpGSCmd [lindex [$xfW config -command] 4]
  167.   if {"$xfTmpGSCmd" == ""} {
  168.     set xfTmpGSCmd $xfFile(gsCmd)
  169.   }
  170.   puts $xfOutFile "  if {\[catch \"tkgs $xfW -command $xfTmpGSCmd \"\]} {"
  171.   puts $xfOutFile "    if {\"\[info procs XFEdit\]\" != \"\"} {"
  172.   puts $xfOutFile "      XFProcError \"Unknown widget type: tkGS\""
  173.   puts $xfOutFile "      return"
  174.   puts $xfOutFile "    } {"
  175.   puts $xfOutFile "      puts stderr \"Unknown widget type: tkGS\""
  176.   puts $xfOutFile "      catch \"destroy .\""
  177.   puts $xfOutFile "      catch \"exit 0\""
  178.   puts $xfOutFile "    }"
  179.   puts $xfOutFile "  }"
  180.  
  181.   puts $xfOutFile "  $xfW config" nonewline
  182.   foreach xfCounter [$xfW config] {
  183.     # only handle options with 5 items per option entry
  184.     if {[llength $xfCounter] == 5} {
  185.       if {"[lindex $xfCounter 0]" == "-command"} {
  186.         continue
  187.       }
  188.       if {"[lindex $xfCounter 3]" != "[lindex $xfCounter 4]"} {
  189.         if {$xfConf(encloseConfigure)} {
  190.           puts $xfOutFile " \\\n    [lindex $xfCounter 0] {[lindex $xfCounter 4]}" nonewline
  191.         } {
  192.           puts $xfOutFile " \\\n    [lindex $xfCounter 0] \"[lindex $xfCounter 4]\"" nonewline
  193.         }
  194.       }
  195.     }
  196.   }
  197.   puts $xfOutFile ""
  198. }
  199.  
  200. ##########
  201. # Procedure: XFTkGSSetTkGS4
  202. # Description: set tkGS parameters
  203. # Arguments: xfW - the widget
  204. #            xfType - the type of setting (1 = set always, 0 = set
  205. #                     only if permanent apply is on)
  206. #            xfClass - the class we configure
  207. #            xfParam1 - ignored parameter
  208. # Returns: none
  209. # Sideeffects: none
  210. ##########
  211. proc XFTkGSSetTkGS4 {xfW xfType xfClass {xfParam1 ""}} {
  212.   global xfConf
  213.   global xfMisc
  214.  
  215.   if {$xfType == 0 && !$xfConf(applyParameters)} {
  216.     return
  217.   }
  218.   XFMiscSetSymbolicName $xfW \
  219.     [.xf${xfClass}Config4.params1.params2.symname.symname get]
  220.  
  221.   set tmpOptions ""
  222.   if {"[.xf${xfClass}Config4.params1.params2.bg.bg get]" != ""} {
  223.     append tmpOptions \
  224.       " -background \"[.xf${xfClass}Config4.params1.params2.bg.bg get]\""
  225.   }
  226.   append tmpOptions \
  227.     " -bbox \"[.xf${xfClass}Config4.params1.params2.bbox.bbox get]\""
  228.   append tmpOptions \
  229.     " -borderwidth [.xf${xfClass}Config4.params1.params2.borderwidth.borderwidth get]"
  230.   append tmpOptions \
  231.     " -command \{[.xf${xfClass}Config4.params1.params2.command.command get]\}"
  232.   append tmpOptions \
  233.     " -file \{[.xf${xfClass}Config4.params1.params2.file.file get]\}"
  234.   append tmpOptions \
  235.     " -height [.xf${xfClass}Config4.params1.params2.size.size2.size2 get]"
  236.   append tmpOptions \
  237.     " -orient [.xf${xfClass}Config4.params1.params2.orient.orient get]"
  238.   append tmpOptions \
  239.     " -relief $xfMisc(relief)"
  240.   append tmpOptions \
  241.     " -width [.xf${xfClass}Config4.params1.params2.size.size1.size1 get]"
  242.   append tmpOptions \
  243.     " -xdpi [.xf${xfClass}Config4.params1.params2.xdpi.xdpi get]"
  244.   append tmpOptions \
  245.     " -ydpi [.xf${xfClass}Config4.params1.params2.ydpi.ydpi get]"
  246.   if {[catch "$xfW configure $tmpOptions" xfResult]} {
  247.     XFProcError "$xfW\n$xfResult"
  248.   }
  249. }
  250.  
  251. # eof
  252.  
  253.